Shareware Grab Bag/Shareware Grab Bag.iso/090/jupmoons.arc/JUPHOUR.PAS

Pascal/Delphi Source File | 1985-09-22 | 13.8 KB | 394 lines

program JupiterMoons (input,output);
     {Public Domain                                                }
     {Displays changing positions of Jupitor's 1st 4 moons.        }
     {Works with MONO or Color                                     }
     {Input months as shown ..observe Upper case and lower case    }
     {Use integer days and hours: Universal time                   }
     {Try a period of about 5 days, more is slow to finish         }
     {To show one position, input Start and End times the same     }
     {Good for 1985 only, update first 4 constants for another year}
     {Based on circular orbit approximation                        }
     {Have fun ! Write some public domain astronomy software       }

type month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec,
                                                NotYetAssigned);
var
    StartMonth, EndMonth:month;
    StartDay,EndDay,StartHour,EndHour:integer;
    Days,PhaseDays:real;

const
      StartAngleIo = 185 ;          { Ref Data: 00Z  1 Jan 85 }
      StartAngleEuropa = 10;
      StartAngleGanymede = 25 ;
      StartAngleCallisto = 45;


      LargestOrbit = 1885; {Callisto, 1,885,000 km}

      PeriodIo = 1.769;              {Earth days}
      MaxDistIo = 442;               {x 1000 km}
        PeriodEuropa = 3.551;
        MaxDistEuropa = 671;
          PeriodGanymede = 7.155;
          MaxDistGanymede = 1070;
            PeriodCallisto = 16.689;
            MaxDistCallisto = 1885;

      ScreenOffset = 40;
      zeroize = 0;

      YIo =14; YEuropa = 15; YGanymede = 18; YCallisto =19;
      ExIo = 1; ExEuropa = 23; ExGanymede = 44; ExCallisto =66;
      YJupitor   = 17;
      XJupitor   = 40;
      Io = '·';         { ASCII 250 }
      Europa = '·';     {   "   250 }
      Ganymede = '∙';   {   "   249 }
      Callisto = '∙';   {   "   249 }
      Jupitor = '(_)';

      IoName = 'I'; EuropaName = 'E'; GanymedeName = 'G';
      CallistoName = 'C';


      FirstMonthOfYear = Jan;
      FirstDayOfYear = 1;
      FirstHourOfYear = 0;

var ScalingFactor: real;
    DaysDisplayed: real;
    TimeIncrement: real;
    Time: real;
    AngleIo,AngleEuropa,AngleGanymede,AngleCallisto: real;
    AngleChangeIo,AngleChangeEuropa,AngleChangeGanymede: real;
    AngleChangeCallisto: real;
    PositionIo,PositionEuropa,PositionGanymede,
                                    PositionCallisto: integer;
    OldPositionIo,OldPositionEuropa,OldPositionGanymede,
                                  OldPositionCallisto:integer;

    DistanceIo,DistanceEuropa,DistanceGanymede,DistanceCallisto
                                                         :real;


procedure cursor(Top,Bottom:integer);

       { Sets size of cursor:   top line    =  0
                                bottom line = 13
              if Top < Bottom then normal cursor.
              if Top > Bottom then 2-part cursor.
              if Top = Bottom then thinnest cursor.
              if Top = Bottom = 14 then no cursor.
              if Top and/or Bottom > 14 or < 0 then ????. }

  var Ctop,Cbottom:integer;

  begin
    Ctop := Top; Cbottom := Bottom;
    if (Ctop<0) or (Ctop>14) then Ctop := 12;
    if (Cbottom<0) or (Cbottom>14) then Cbottom := 13;

    inline
            { Interrupts BIOS for cursor size
                 INT 10H with AH = 01H
                 CH = top of cursor, bits 0-4
                 CL = bottom of cursor, bits 0-4
                 CH,CL   bits 5-7 should be 0.   }

     ($50/                   { PUSH AX                       }
      $51/                   { PUSH CX                       }
      $8B/$86/CTOP/          { MOV AX,SS:[BP]+OFFSET CTOP    }
      $8A/$E8/               { MOV CH,AL                     }
      $8B/$86/CBOTTOM/       { MOV AX,SS:[BP]+OFFSET CBOTTOM }
      $8A/$C8/               { MOV CL,AL                     }
      $B4/$01/               { MOV AH,O1H                    }
      $FB/                   { STI                           }
      $CD/$10/               { INT 10H                       }
      $59/                   { POP CX                        }
      $58);                  { POP AX                        }


  end; {cursor}


procedure ExactPositions(ExMoon:integer;DistanceMoon:real);
     begin
        GoToXY(ExMoon,24); write('    ');
        GoToXY(ExMoon,24); write(DistanceMoon:5:0,',000 KM')
     end;  {ExactPositions}


procedure LocateMoon(AngleMoon:real;MaxDistMoon:real;
              var DistanceMoon:real; var PositionMoon:integer);

     var RadianMoon: real;

     begin
        RadianMoon := AngleMoon * (Pi/180);
        DistanceMoon := MaxDistMoon * sin(RadianMoon);
        PositionMoon := round(DistanceMoon/ScalingFactor)
                                                + ScreenOffset
     end;   {LocateMoon}

procedure EraseMoon(DeletePositionMoon,YMoon:integer);

     begin
        GoToXY(DeletePositionMoon,YMoon);
        write(' ');
        GoToXY(DeletePositionMoon,YJupitor);
        write(' ')
     end;  {EraseMoon}


procedure PlotMoon (var OldPositionMoon:integer;PositionMoon:integer;
                             Moon:char; YMoon:integer;MoonName:char);

     begin
        GoToXY(PositionMoon,YMoon);
        write(MoonName);
        GoToXY(PositionMoon,YJupitor);
        write (Moon);

        OldPositionMoon := PositionMoon

     end;   {PlotMoon}

procedure GetDate(var GetMonth:month;var GetDay,GetHour:integer);

     type reply = string[3];

     const Blank = -1;  {for dummy variables}

     var WhatMonth: reply;
         MaxDays: integer;
     begin
        while GetMonth = NotYetAssigned
          do begin
              GoToXY(25,8); write('What month, Jan..Dec ?       ');
              GoToXY(50,8); read(WhatMonth);
                if WhatMonth = 'Jan' then GetMonth := Jan;
                if WhatMonth = 'Feb' then Getmonth := Feb;
                if WhatMonth = 'Mar' then Getmonth := Mar;
                if WhatMonth = 'Apr' then Getmonth := Apr;
                if WhatMonth = 'May' then GetMonth := May;
                if Whatmonth = 'Jun' then GetMonth := Jun;
                if WhatMonth = 'Jul' then GetMonth := Jul;
                if WhatMonth = 'Aug' then GetMonth := Aug;
                if WhatMonth = 'Sep' then GetMonth := Sep;
                if WhatMonth = 'Oct' then GetMonth := Oct;
                if WhatMonth = 'Nov' then GetMonth := Nov;
                if WhatMonth = 'Dec' then Getmonth := Dec
              end; {while}
         case GetMonth of
           Jan,Mar,May,Jul,Aug,Oct,Dec: MaxDays := 31;
           Sep,Apr,Jun,Nov: MaxDays := 30;
           Feb: MaxDays := 29
         end; {case}

      GetDay := Blank;
         while not (GetDay in [1..MaxDays]) do
            begin
               GoToXY(25,10);write('What day, 1..',MaxDays,' ?     ');
               GoToXY(45,10);read(GetDay)
            end; {while}

      GetHour := Blank;
         while not (GetHour in [0..23]) do
            begin
               GoToXY(25,12);write('What hour, 0..23 ?       ');
               GoToXY(45,12);read(GetHour)
            end; {while}
         delay(1000);
         GoToXY(25,8); clrEOL;
         GoToXY(25,10); clrEOL;
         GoToXY(25,12); clrEOL
     end;  {GetDate}

procedure StartAndEnd;
     var EndAfterStart:boolean;
     begin
       EndAfterStart := False;
       while not EndAfterStart
          do begin

              StartMonth := NotYetAssigned;
              GoToXY(30,6);write('STARTING DATE/TIME');
              GetDate(StartMonth,StartDay,StartHour);
              GoToXY(30,6); clrEOL;

            EndMonth := NotYetAssigned;
            GoToXY(30,6);write('END DATE/TIME');
            GetDate(EndMonth,EndDay,EndHour);
            GoToXY(30,6); clrEOL;


           if
                 (EndMonth < StartMonth)
              or ((EndMonth = StartMonth) and (EndDay < StartDay))
              or ((EndMonth = StartMonth) and (EndDay = StartDay)
                                          and (EndHour < StartHour))
           then begin
                  GoToXY(25,8);write('We can''t END before BEGIN');
                  delay(5000)
                end {then}

           else EndAfterStart := true

       end {while}
     end;  {StartAndEnd}


  function DaysInMonth(FirstMonth:month):integer;

     begin
         case FirstMonth of
                Jan,Mar,May,Jul,Aug,Oct,Dec:DaysInMonth := 31;
                Sep,Apr,Jun,Nov:DaysInMonth := 30;
                Feb:DaysInMonth := 28
              end  {case}
     end;  {DaysInMonth}

procedure DaysBetweenDates(var TotalDays:real;FirstMonth,SecondMonth
           :month;FirstDay,SecondDay,FirstHour,SecondHour:integer);

   var MaxDaysFirst:integer;

   begin
      if FirstHour <= SecondHour
      then TotalDays := TotalDays + (SecondHour - FirstHour)/24
      else TotalDays := TotalDays -1+(24 - FirstHour + SecondHour)/24;

      if FirstDay <= SecondDay
      then TotalDays := TotalDays + (SecondDay - FirstDay)
      else begin
           MaxDaysFirst := DaysInMonth(FirstMonth);
           TotalDays := TotalDays + MaxDaysFirst - FirstDay+SecondDay;
           SecondMonth := pred(SecondMonth)
           end; {else}

      while FirstMonth < SecondMonth
        do begin
           TotalDays := TotalDays + DaysInMonth(FirstMonth);
           FirstMonth := succ(FirstMonth)
           end  {while}
     end;  {DaysBetweenDates}

procedure GetStartAngles;

       begin
        AngleIo := AngleIo +(360/PeriodIo*PhaseDays);
        AngleEuropa := AngleEuropa +(360/PeriodEuropa*PhaseDays);
        AngleGanymede := AngleGanymede+(360/PeriodGanymede*PhaseDays);
        AngleCallisto := AngleCallisto+(360/PeriodCallisto*PhaseDays);

     while AngleIo >= 360 do AngleIo := AngleIo-360;
     while AngleEuropa >= 360 do AngleEuropa := AngleEuropa-360;
     while AngleGanymede >= 360 do AngleGanymede := AngleGanymede-360;
     while AngleCallisto >= 360 do AngleCallisto := AngleCallisto-360

        end;  {GetStartAngles}

begin  {******************** MAIN *********************}

      cursor(14,14);

      ScalingFactor := LargestOrbit / (ScreenOffset-1);

      AngleIo := StartAngleIo;
      AngleEuropa := StartAngleEuropa;
      AngleGanymede := StartAngleGanymede;
      AngleCallisto := StartAngleCallisto;

      OldPositionIo := XJupitor;         {DummyPositions}
      OldPositionEuropa := XJupitor;
      OldPositionGanymede := XJupitor;
      OldPositionCallisto := XJupitor;

      Time := Zeroize;

      TimeIncrement := 1/12;
      ClrScr;

      StartAndEnd; {Get Dates}

      Days := 0;
      DaysBetweenDates(Days,StartMonth,EndMonth,StartDay,EndDay,
                       StartHour,EndHour);

      DaysDisplayed := Days;

      PhaseDays := 0;
      DaysBetweenDates(PhaseDays,FirstMonthOfYear,StartMonth,
                       FirstDayOfYear,StartDay,FirstHourOfYear
                       ,StartHour);
      GetStartAngles;
      ClrScr;
      GoToXY(XJupitor,YJupitor-1);    {Draw Jupitor}
      write('_');
      GoToXY(XJupitor-1,YJupitor);
      write (Jupitor);

      GoToXY(30,3); write('Satellites of Jupitor');

      {GoToXY(70,3);write(Days:3:0);}  {To Print, remove braces}
      {GoToXY(70,5);write(PhaseDays);}

      GoToXY(ExIo,23);         write('   I = Io');
      GoToXY(ExEuropa,23);     write('  E = Europa');
      GoToXY(ExGanymede,23);   write('G = Ganymede');
      GoToXY(ExCallisto,23);   write('C = Callisto');

      AngleChangeIo := (360/PeriodIo)*(TimeIncrement);
      AngleChangeEuropa := (360/PeriodEuropa)*(TimeIncrement);
      AngleChangeGanymede := (360/PeriodGanymede)*(TimeIncrement);
      AngleChangeCallisto := (360/PeriodCallisto)*(TimeIncrement);

      while Time <= DaysDisplayed
         do begin

            LocateMoon(AngleIo,MaxDistIo,DistanceIo,PositionIo);
            LocateMoon(AngleEuropa,MaxDistEuropa,DistanceEuropa,
                                                       PositionEuropa);
            LocateMoon(AngleGanymede,MaxDistGanymede,DistanceGanymede,
                                                     PositionGanymede);
            LocateMoon(AngleCallisto,MaxDistCallisto,DistanceCallisto,
                                                     PositionCallisto);

               EraseMoon(OldPositionIo,YIo);
               EraseMoon(OldPositionEuropa,YEuropa);
               EraseMoon(OldPositionGanymede,YGanymede);
               EraseMoon(OldPositionCallisto,YCallisto);

            PlotMoon(OldPositionIo,PositionIo,Io,YIo,IoName);
            PlotMoon(OldPositionEuropa,PositionEuropa,Europa,YEuropa,
                                                          EuropaName);
            PlotMoon(OldPositionGanymede,PositionGanymede,Ganymede,
                                              YGanymede,GanymedeName);
            PlotMoon(OldPositionCallisto,PositionCallisto,Callisto,
                                              YCallisto,CallistoName);
               ExactPositions(ExIo,DistanceIo);
               ExactPositions(ExEuropa,DistanceEuropa);
               ExactPositions(ExGanymede,DistanceGanymede);
               ExactPositions(ExCallisto,DistanceCallisto);

               GoToXY(XJupitor-1,YJupitor);
               write(Jupitor);
               GoToXY(1,1);  {Get cursor away from Callisto}

               AngleIo := AngleIo + AngleChangeIo;
               AngleEuropa := AngleEuropa + AngleChangeEuropa;
               AngleGanymede := AngleGanymede + AngleChangeGanymede;
               AngleCallisto := AngleCallisto + AngleChangeCallisto;

               Time := Time + TimeIncrement;
               if KeyPressed then Time := DaysDisplayed+1; {Escape !}

            end;   {while}
            cursor(12,13)

end.  {******************** MAIN **********************}